options(scipen = 999)
library(tidyverse)
library(tidycensus)
library(urbnthemes)
library(patchwork)
library(sf)
set_urbn_defaults()
OUR MISSION IS TO OPEN MINDS, SHAPE DECISIONS, AND OFFER SOLUTIONS THROUGH ECONOMIC AND SOCIAL POLICY RESEARCH.
The Urban Institute is the trusted source for unbiased, authoritative insights that inform consequential choices about the well-being of people and places in the United States. We are a nonprofit research organization that believes decisions shaped by facts, rather than ideology, have the power to improve public policy and practice, strengthen communities, and transform people’s lives for the better.
Our experts diagnose current challenges and look ahead to identify opportunities for change. And we don’t stop there. We use our research findings to help stakeholders craft relevant solutions and strategies that address today’s concerns and avert tomorrow’s roadblocks. And we share our insights in real time with influencers eager to make smarter decisions.
The Urban Institute works on issues ranging from large federal programs like Social Security down to local issues like school funding and housing. We are divided into ten research teams:
The Capital Region Collaborative includes:
Note: Ashland is treated as part of Hanover for this analysis
counties <- tribble(
~county, ~fips,
"Charles City", "51036",
"Chesterfield", "51041",
"Goochland", "51075",
"Hanover", "51085",
"Henrico", "51087",
"New Kent", "51127",
"Powhatan", "51145",
"Richmond", "51760"
)
population <- bind_rows(
`2000` = get_decennial(geography = "county", variables = "P001001", year = 2000, state = "VA"),
`2010` = get_decennial(geography = "county", variables = "P001001", year = 2010, state = "VA"),
`2019` = get_estimates(geography = "county", product = "population", year = 2019, state = "VA"),
.id = "year"
) %>%
filter(GEOID %in% counties$fips)
population %>%
filter(year == 2019,
variable != "DENSITY") %>%
mutate(NAME = str_replace(NAME, ", Virginia", "")) %>%
mutate(NAME = fct_reorder(NAME, value)) %>%
ggplot(aes(y = NAME, value)) +
geom_col() +
scale_x_continuous(limits = c(0, 400000),
expand = c(0, 0),
labels = scales::comma) +
labs(title = "CRC County and City Populations in 2019",
x = "Population",
y = NULL,
caption = "Source: Census Bureau's Population Estimates Project") +
scatter_grid()
population_change <- population %>%
filter(variable != "DENSITY") %>%
group_by(GEOID) %>%
mutate(change = value - lag(value),
prop_change = (value - lag(value)) / lag(value)) %>%
ungroup() %>%
filter(!is.na(prop_change))
population_change2010 <- population_change %>%
filter(year == 2010) %>%
mutate(NAME = str_replace(NAME, ", Virginia", "")) %>%
mutate(NAME = fct_reorder(NAME, prop_change)) %>%
ggplot() +
geom_vline(aes(xintercept = 0)) +
geom_col(aes(y = NAME, x = prop_change), position = "dodge") +
#geom_text(aes(y = NAME, x = prop_change - 0.01, label = scales::percent(prop_change)), color = "white") +
scale_x_continuous(expand = c(0, 0),
limits = c(-0.1, 0.5),
labels = scales::percent_format(accuracy = 5L)) +
labs(title = "Population Growth",
subtitle = "2000-2010",
x = "Percent Change in Population from 2000 to 2010",
y = NULL,
caption = NULL) +
scatter_grid()
population_change2019 <- population_change %>%
filter(year == 2019) %>%
mutate(NAME = str_replace(NAME, ", Virginia", "")) %>%
mutate(NAME = fct_reorder(NAME, prop_change)) %>%
ggplot() +
geom_col(aes(y = NAME, x = prop_change), position = "dodge") +
geom_vline(aes(xintercept = 0)) +
#geom_text(aes(y = NAME, x = prop_change - 0.01, label = scales::percent(prop_change)), color = "white") +
scale_x_continuous(expand = c(0, 0),
limits = c(-0.1, 0.5),
labels = scales::percent_format(accuracy = 5L)) +
labs(title = "",
subtitle = "2010-2019",
x = "Percent Change in Population from 2010 to 2019",
y = NULL,
caption = "Source: 2000 Census, 2010 Census, 2019 Population Estimates Project") +
scatter_grid()
population_change2010 + population_change2019
Takeaway: Richmond City was a laggard in population growth from 2000-2010 and a leader in population growth from 2010-2019.
population %>%
filter(variable == "DENSITY") %>%
mutate(NAME = str_replace(NAME, ", Virginia", "")) %>%
mutate(NAME = fct_reorder(NAME, value)) %>%
ggplot(aes(x = value, y = NAME)) +
geom_col() +
scale_x_continuous(limits = c(0, 4000),
expand = c(0, 0),
labels = scales::comma) +
labs(title = "Population Density is Very Low in the CRC--Even in Richmond City",
x = "Residents Per Square Mile, 2019",
y = NULL,
caption = "Census Population Estimates Project, 2019") +
scatter_grid()
| City | Residents Per Square Mile |
|---|---|
| London, England | 14,670 |
| Queens, NY | 20,907 |
| Paris, France | 53,760 |
| Manhattan, NY | 68,468 |
Source: Wikipedia
Takeaway: The CRC is sprawled and even Richmond, City has limited population density. Modest density and transit-oriented walkable neighborhoods are a key tool in mitigating climate change.
var_list <- load_variables(2018, "acs5", cache = TRUE)
vars <- tribble(
~variable, ~var_name,
"B01003_001", "population",
"B19301_001", "pc_income",
"B06012_002", "poverty",
"B01002_001", "median_age",
"DP05_0077P", "nhw",
"DP02_0064P", "ed_ba",
"DP02_0065P", "ed_ma"
)
pull_acs <- function(state, variables, geography) {
get_acs(geography = geography,
variables = variables,
year = 2018,
state = state,
geometry = TRUE,
progress = FALSE)
}
county_data <- pull_acs("VA", variables = vars$variable, geography = "county") %>%
filter(GEOID %in% counties$fips) %>%
left_join(vars, by = "variable") %>%
select(NAME,
fips = GEOID,
var_name,
estimate,
geometry)
counties_outline <- county_data %>%
filter(var_name == "population")
county_labels <- county_data %>%
filter(var_name == "population") %>%
group_by(fips) %>%
summarize(centers = sf::st_centroid(geometry)) %>%
left_join(counties, by = "fips")
new_point <- st_point(c(-77.3, 37.45))
county_labels[county_labels$county == "Henrico", ]$centers[[1]] <- new_point
tracts_data <- pull_acs("VA", variables = vars$variable, geography = "tract") %>%
mutate(fips = str_sub(GEOID, 1, 5)) %>%
filter(fips %in% counties$fips) %>%
left_join(vars, by = "variable") %>%
select(NAME,
fips = GEOID,
var_name,
estimate,
geometry)
Takeaway: The exurbs are much older than average in the CRC and Richmond, City is much younger than average.
ggplot() +
geom_sf(data = filter(county_data, var_name == "median_age"),
aes(fill = estimate),
color = "white") +
geom_sf_text(data = county_labels,
aes(label = county),
color = "white",
size = 5) +
scale_fill_gradientn() +
labs(fill = "Median Age",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
tracts_data %>%
filter(var_name == "median_age") %>%
ggplot() +
geom_sf(aes(fill = estimate), color = "white", size = 0.02) +
geom_sf(data = counties_outline, aes(), fill = NA, color = "white", size = 0.2) +
scale_fill_gradientn() +
labs(fill = "Median Age",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
Takeaway: The CRC has high attainment of college degrees, but the degrees are highly concentrated in Northern Chesterfield County, Western Henrico County, and Western Richmond City.
For reference, the national average is about 31.5%.
county_data %>%
filter(var_name %in% c("ed_ba", "ed_ma")) %>%
group_by(NAME, fips) %>%
summarize(ba_plus = sum(estimate)) %>%
mutate(ba_plus = ba_plus / 100) %>%
ggplot() +
geom_sf(aes(fill = ba_plus), color = "white") +
geom_sf_text(data = county_labels,
aes(label = county),
color = "white",
size = 5) +
scale_fill_gradientn(labels = scales::percent) +
labs(fill = "Share Ages 25+ with a BA or More",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
tracts_data %>%
filter(var_name %in% c("ed_ba", "ed_ma")) %>%
group_by(fips) %>%
summarize(ba_plus = sum(estimate)) %>%
mutate(ba_plus = ba_plus / 100) %>%
ggplot() +
geom_sf(aes(fill = ba_plus), color = "white", size = 0.02) +
geom_sf(data = counties_outline, aes(), fill = NA, color = "white", size = 0.2) +
scale_fill_gradientn(labels = scales::percent) +
labs(fill = "Share Ages 25+ with a BA or More",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
Takeaway: The CRC contains a wide range of per capita incomes. Much of the variation in incomes in the CRC is obfuscated at the county level.
county_data %>%
filter(var_name == "pc_income") %>%
ggplot() +
geom_sf(aes(fill = estimate), color = "white") +
geom_sf_text(data = county_labels,
aes(label = county),
color = "white",
size = 5) +
scale_fill_gradientn(labels = scales::dollar) +
labs(fill = "Per Capita Income",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
tracts_data %>%
filter(var_name == "pc_income") %>%
ggplot() +
geom_sf(aes(fill = estimate), color = "white", size = 0.02) +
geom_sf(data = counties_outline, aes(), fill = NA, color = "white", size = 0.2) +
scale_fill_gradientn(labels = scales::dollar) +
labs(fill = "Per Capita Income",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
Takeaway: The CRC and Richmond City are highly segregated.
Speaking of race and class, I must note another dramatic change in modern history. We are more segregated today than we were in the 18th and 19th centuries. During Richmond’s first 200 years, black and white residents were more interspersed with one another than they are now. There were black neighborhoods and white neighborhoods to be sure, but commingling was much more common then, most often for reasons related to where people worked.
It was not until the 20th century that Richmond became increasingly segregated, first by law and then by a combination of public policy and practices in the private sector. Beginning in the late ’60s and accelerating in the ’80s and ’90s, racial segregation morphed into socioeconomic segregation.
county_data %>%
filter(var_name == "nhw") %>%
mutate(estimate = estimate / 100) %>%
ggplot() +
geom_sf(aes(fill = estimate), color = "white") +
geom_sf_text(data = county_labels,
aes(label = county),
color = "white",
size = 5) +
scale_fill_gradientn(labels = scales::percent) +
labs(fill = "Share Non-Hispanic White",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
tracts_data %>%
filter(var_name == "nhw") %>%
mutate(estimate = estimate / 100) %>%
ggplot() +
geom_sf(aes(fill = estimate), color = "white", size = 0.02) +
geom_sf(data = counties_outline, aes(), fill = NA, color = "white", size = 0.2) +
scale_fill_gradientn(labels = scales::percent, limits = c(0, 1)) +
labs(fill = "Share Non-Hispanic White",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
Takeaway: Poverty is heavily-concentrated in Eastern Chesterfield County, Eastern Richmond City, and Eastern Henrico County.
The race/ethnicity maps and the poverty maps look similar. The concentration of poverty and lack of opportunity for the CRC’s black residents, and segregartion were by design.
They are the result of explicitly racist neighborhoods and laws, redlining, Massive Resistance, highway construction that demolished successful black neighborhoods, racist housing practices, and more.
Too little has been done to unwind its devastation.
county_poverty <- get_acs(geography = "county",
variables = c(population = "B01003_001",
poverty = "B06012_002"),
year = 2018,
state = "VA",
output= "wide",
geo = TRUE) %>%
filter(GEOID %in% counties$fips) %>%
mutate(poverty = povertyE / populationE)
county_poverty %>%
ggplot() +
geom_sf(aes(fill = poverty), color = "white") +
geom_sf_text(data = county_labels,
aes(label = county),
color = "white",
size = 5) +
scale_fill_gradientn(labels = scales::percent,
limits = c(0, 0.25)) +
labs(caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
tract_poverty <- get_acs(geography = "tract",
variables = c(population = "B01003_001",
poverty = "B06012_002"),
year = 2018,
state = "VA",
output= "wide",
geo = TRUE) %>%
mutate(fips = str_sub(GEOID, 1, 5)) %>%
filter(fips %in% counties$fips) %>%
mutate(poverty = povertyE / populationE)
tract_poverty %>%
ggplot() +
geom_sf(aes(fill = poverty), color = "white", size = 0.02) +
geom_sf(data = counties_outline, aes(), fill = NA, color = "white", size = 0.2) +
scale_fill_gradientn(labels = scales::percent, limits = c(0, 0.8)) +
labs(fill = "",
caption = "Source: 2014-2018 5-Year American Community Survey") +
theme_urbn_map()
Maps for other indicators like employment, health insurance coverage, and life expectancy will largely reflect the same patterns as the maps for poverty and race/ethnicity.